REM > Director:Menus.System.DoDeskFont
REM   Lenny: 24 Feb 2002
:
fh%=0:ON ERROR PROCerror:END
SYS "OS_GetEnv" TO in$
font$=FNarg(in$,"-font","")
DIM block% 256,buff% 256
IF font$="" ERROR 1,"Missing fontname.  Syntax: DoDeskFont -font SystemFont|<fontname>"
fon%=0:c%=1
newboot%=FNdir_exists("<Choices$Write>.Boot.PreDesk")
SYS "Wimp_Initialise",350,&4B534154,"DoDeskFont"

OSCLI "UnSet Wimp$Font"
IF font$="SystemFont" THEN
 fon%=1
ELSE
 PROCscandir("Resources:$.Fonts","",font$)
 IF fon%>15 fon%=0
 IF fon%=0 THEN OSCLI "Set Wimp$Font \F"+font$
ENDIF

IF newboot% THEN
 file$="<Choices$Write>.Boot.PreDesk.FontSetup"
 IF fon%=0 THEN PROCwrite(file$,font$) ELSE PROCdelete(file$)
 PROCupdate_CMOS(fon%)
 PROCrefresh_screen
ELSE
 IF fon%=0 THEN
  PROCreport("New boot not present, thus only System or ROM fonts are selectable as the desktop font.")
 ELSE
  PROCupdate_CMOS(fon%)
  PROCrefresh_screen
 ENDIF
ENDIF
END
:
:
DEF FNarg(str$,arg$,def$)
 LOCAL i,j
 i=INSTR(str$,arg$)
 IF i=0 THEN =def$
 i+=LEN arg$+1
 j=INSTR(str$+" <"," ",i)
=MID$(str$,i,j-i)
:
DEF FNstring0(a%)
 LOCAL a$:a$=""
 WHILE ?a%<>0
  a$+=CHR$?a%
  a%+=1
 ENDWHILE
=a$
:
DEF FNupper(a$)
 LOCAL uc$,c%,i%:uc$=""
 FOR i%=1 TO LEN(a$)
  c%=ASC(MID$(a$,i%,1))
  IF (c% AND &40) THEN c%=c% AND &DF
  uc$+=CHR$(c%)
 NEXT
=uc$
:
DEF PROCscandir(dir$,limb$,find$)
 LOCAL i%,read%,leaf$,name$
 i%=0
 REPEAT
  SYS "OS_GBPB",12,dir$,buff%,1,i%,256,0 TO ,,,read%,i%
  IF read%<>0 THEN
   leaf$=FNstring0(buff%+24)
   path$=dir$+"."+leaf$
   name$=leaf$
   IF limb$<>"" name$=limb$+"."+leaf$
   CASE buff%!16 OF
    WHEN 1 : REM  File
     IF FNupper(LEFT$(leaf$,9))="INTMETRIC" THEN
      c%+=1
      IF limb$=find$ fon%=c%
     ENDIF
    WHEN 2 : REM  Dir
     PROCscandir(path$,name$,find$)
   ENDCASE
  ENDIF
 UNTIL i%=-1 OR fon%<>0
ENDPROC
:
DEF PROCwrite(file$,font$)
 fh%=OPENOUT(file$)
 IF fh%<>0 THEN
  BPUT#fh%,"|"
  BPUT#fh%,"| Font setup file"
  BPUT#fh%,"|"
  BPUT#fh%,"| This file was automatically generated by Director (DoDeskFont)."
  BPUT#fh%,"| Do not edit it by hand."
  BPUT#fh%,"|"
  BPUT#fh%,"Set Wimp$Font \F"+font$
  CLOSE#fh%
  SYS "OS_File",18,file$,&FEB
 ENDIF
ENDPROC
:
DEF PROCdelete(file$)
 IF FNfile_exists(file$) THEN OSCLI "Delete "+file$
ENDPROC
:
DEF FNdir_exists(path$)
 LOCAL type%:type%=0
 SYS "OS_File",17,path$ TO type%
=(type%=2)
:
DEF FNfile_exists(path$)
 LOCAL type%:type%=0
 SYS "OS_File",17,path$ TO type%
=(type%=1)
:
DEF PROCupdate_CMOS(val%)
 LOCAL oldval%,newval%
 SYS "OS_Byte",161,140 TO ,,oldval%
 newval%=(oldval% AND &E1) OR (val% << 1)
 SYS "OS_Byte",162,140,newval%
ENDPROC
:
DEF PROCrefresh_screen
 REM Broadcast Message_FontChanged ..
 !block%=16:block%!16=&400CF
 SYS "Wimp_SendMessage",17,block%,0
ENDPROC
:
DEF PROCreport(msg$)
 !block%=1
 $(block%+4)=msg$
 SYS "Wimp_ReportError",block%,1,"Director (DoDeskFont)"
ENDPROC
:
DEF PROCerror
 ON ERROR OFF
 IF fh%<>0 CLOSE#fh%
 VDU 4
 PRINT "Error in: !Director.Menus.System.DoDeskFont"
 PRINT "Report:   ";REPORT$
 IF ERR<>1 PRINT "Line:     ";ERL
ENDPROC
